unit Unit2;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, IBConnection, sqldb, FileUtil, Forms, Controls, Graphics,
  Dialogs, StdCtrls, Buttons, IBQuery, IBSQL, IBStoredProc, IBDatabase,
  FBLScript, FBLTransaction, FBLDatabase, ZConnection, ZDataset,
  ZStoredProcedure, ZSqlProcessor;

const
    fe_OK                = 000;
    fe_BadChar           = 001;
    fe_TextTooLong       = 002;
    fe_FloatExpected     = 003;
    fe_IntExpected       = 004;
    fe_FloatTooBig       = 005;

    table_count          = 009; // ilosc tabel w bazie, potrzebne do tworzenia nowej bazy

type

  { TForm2 }

  TForm2 = class(TForm)
    BitBtn1: TBitBtn;
    Button1: TButton;
    ed_urz_zew: TEdit;
    ed_stand: TComboBox;
    ed_path_baza: TEdit;
    ed_user: TEdit;
    ed_pass: TEdit;
    ed_srv_addr: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    ibq: TIBQuery;
    ibsql: TIBSQL;
    ibproc: TIBStoredProc;
    ibt: TIBTransaction;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    od1: TOpenDialog;

    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ed_srv_addrChange(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  private
    { private declarations }
  public
    { public declarations }
    function  sql_exec( sql_txt: string): boolean;

  end;

  TMFieldDef = record
     f_name : string[40]; // nazwa pola
     f_type : string[40]; // typ i ewentualna szerokosc
  end;

  TMTableDef = record
     name   : string;     // nazwa tabeli
     fcount : integer;    // ilosc pol
     fields : array[1..20] of TMFieldDef;
  end;

var
  Form2: TForm2;

var
  tables : array[1..table_count] of TMTableDef;


  function FieldValid(fld : TMFieldDef; buf : string):integer;


implementation
uses
  Unit6;
{$R *.lfm}

{ TForm2 }

function IsFloat(txt : string):boolean;
var
  i : integer;
begin
  IsFloat:=false;
  for i:=1 to length(txt) do if not (txt[i] in ['0'..'9',',','-']) then exit;
  IsFloat:=true;
end;


procedure TForm2.Button1Click(Sender: TObject);
begin
  if od1.Execute then ed_path_baza.Text:=od1.FileName;
end;

procedure TForm2.BitBtn1Click(Sender: TObject);
begin

end;

procedure TForm2.ed_srv_addrChange(Sender: TObject);
begin
  ed_srv_addr.Color:=clWhite;;
end;

procedure TForm2.FormClose(Sender: TObject; var CloseAction: TCloseAction);
var
  dot_cnt,err : integer;
  buf         : string;
begin
  CloseAction:=caHide;
end;


function TForm2.sql_exec( sql_txt: string): boolean;
begin
  sql_exec:=true;
  if ibq.Active then ibq.Close;
  ibq.SQL.Clear;
  ibq.SQL.Add(sql_txt);
  ibq.SQL.SaveToFile('c:\tmp\debug.txt');
  try
    ibq.ExecSQL;
  except
    sql_exec:=false;
  end;
end;



// -----------------------------------------------------------------------------
// funkcja ma za zadanie dodac na poczatku i koncu kazdego pisanego slowa %
// chodzi o wysukiwanie za pomocą kilku fraz na raz w instrukcjach select
// -----------------------------------------------------------------------------
function PrepWords(txt : string): string;
var
  res,w : string;
begin
  res:='';
  while txt <> '' do
  begin
     while (txt <> '') and (txt[1] = ' ') do delete(txt,1,1);
     w:='';
     while (txt <> '') and (txt[1] <> ' ') do
     begin
       w:=w+txt[1];
       delete(txt,1,1);
     end;
     res:=res+' %'+w+'%';
  end;
  PrepWords:=trim(res);
end;

// -----------------------------------------------------------------------------
// funkcja sprawdza czy podany tekst jest liczbą typu int
// -----------------------------------------------------------------------------

function IsInt(txt : string):boolean;
var
  i : integer;
begin
  IsInt:=false;
  for i:=1 to length(txt) do if not (txt[i] in ['0'..'9']) then
  begin
//    AddLog('(IsInt -> txt=['+txt+'] Pos='+IntToStr(i), nil );
    exit;
  end;
  IsInt:=true;
end;


// -----------------------------------------------------------------------------
// funkcja sprawdza czy podany bufor jest zgodny z definicją typu pola bazy
// -----------------------------------------------------------------------------

function FieldValid(fld : TMFieldDef; buf : string):Integer;
var
  a : integer;
begin
   // wzroce -> char(000)   numeric(00,00)   integer
   //           123456789   12345678901234   1234567

   FieldValid:=fe_Ok; // zakaladam ze bedzie ok, a wyskok z procedury tylko w przypadku bledu
   fld.f_type:=UpperCase(fld.f_type);

   if copy(fld.f_type,1,4) = 'CHAR' then
   begin
     if pos('''',buf) <> 0 then begin FieldValid:=fe_BadChar; exit; end;
     if pos('^',buf)  <> 0 then begin FieldValid:=fe_BadChar; exit; end;
     a:=StrToInt(copy(fld.f_type,6,3));
     if length(buf) > a then begin FieldValid:=fe_TextTooLong; exit; end;
     FieldValid:=fe_ok;
     exit;
   end;

   if copy(fld.f_type,1,7) = 'NUMERIC' then
   begin
     if not isFloat(buf) then begin FieldValid:=fe_FloatExpected; exit; end;
     a:=StrToInt(copy(fld.f_type, 9, 2));
     if length(buf) > a then begin FieldValid:=fe_FloatTooBig; exit; end;
     FieldValid:=fe_ok;
     exit;
   end;

   if copy(fld.f_type,1,7) = 'INTEGER' then
   begin
      if not IsInt(buf) then begin FieldValid:=fe_IntExpected; exit; end;
      FieldValid:=fe_OK;
      exit;
   end;
end;

initialization


end.


